COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Definitions -- this program must be assembled with file DEFS.
C00003 00003	UUCODE:	0
C00004 00004	CHK
C00007 00005		SETZB	L,B
C00012 00006	GETFIL	DECOUT	NXTDG	NOLOOK	NOENTR
C00018 00007	GETDAY	DATA
C00019 ENDMK
C⊗;
;Definitions -- this program must be assembled with file DEFS.
	TITLE CHK program to check consistency of NS data file

F←0
A←1
B←2
C←3
D←4
E←5

L←6
M←7
N←10

Q←11
R←12

W←13
X←14
Y←15
Z←16

P←17

LPDL←←30
PDL:	BLOCK	LPDL

QUOTE←←400000
GOTPN←←200000
GOTP ←←100000
GOTEXT←←40000

LSYM←←2000
SYM:	BLOCK	LSYM

LBUF←←40
TYBUF:	BLOCK LBUF
TYPNT:	0
FILEF:	BLOCK	4
MAXPTR:	0		;MAX LEGAL VALUE FOR PTR IN DAT FILE
CMD:	IOWD	1,DATA
	0

ERRBK:	SIXBIT	/DSK/
	ERRPRG
	'DMP',,0
	1		;STARTING ADDRESS INCREMENT
	APPPN
UUCODE:	0
	RESET
	PUSH	P,A
	SETO	A,
	GETLIN	A
	AOJE	A,DET		;JUMP IF DETACHED
	OUTSTR	[ASCIZ/
Error #/]
	PUSH	P,L
	PUSH	P,M
	PUSH	P,Q
	HRRZ	L,40		;ERROR CODE
	PUSHJ	P,DECOUT
	POP	P,Q
	POP	P,M
	POP	P,L
	POP	P,A
	OUTCHR	["."]
	EXIT	1,
	JRST	@UUCODE


DET:	MOVSI	A,'CHK'		;PASS PROGRAM NAME IN AC 1
	MOVE	B,40		;PASS ERROR UUO IN AC 2
	MOVEI	16,ERRBK
	SWAP	16,
	EXIT
;CHK
	JRST	[SETOM AUTOCK↔JRST CHK00];CHECK LAST COMPLETE DAY'S NEWS : -1
CHK:	TDZA	A,A			;CHECK TODAY'S NEWS		 :  0
	MOVEI	A,-1			;STARTED UP HERE TO READ FILENAME:  0,,-1
	MOVEM	A,AUTOCK#		;FLAG WHETHER TO ASK FOR FILENAME
CHK00:	RESET
	MOVE	P,[IOWD LPDL,PDL]
	SKIPLE	AUTOCK
	OUTSTR	[ASCIZ/DATA FILE: /]
	SETZM	JOBREN↑

	HRLZ	W,JOBSYM↑
	CAMN	W,[SYM,,0]
	JRST	NOMOVE
	HRRI	W,SYM
	HRRM	W,JOBSYM
	HLRE	X,JOBSYM
	MOVN	X,X
	CAILE	X,LSYM
	UFATAL	402		;;;NOT ENOUGH ROOM FOR SYMBOLS
	ADDI	X,-1(W)
	BLT	W,(X)
NOMOVE:
	SKIPG	AUTOCK		;SKIP IF WANT TO READ FILENAME
	JRST	GETDAY

	MOVE	B,[POINT 7,TYBUF]
	MOVEM	B,TYPNT
CHK1:	INCHWL	C		;READ FILENAME FROM TTY
	IDPB	C,B
	CAIE	C,LF
	JRST	CHK1
	ILDB	C,TYPNT
	PUSHJ	P,GETFIL
	HALT	.

	MOVE	A,[FILEF,,W]
	BLT	A,Z
	SKIPN	W
	DAYCNT	W,		;ASSUME TODAY

	TLNN	F,GOTEXT
	MOVSI	X,'DAT'

	MOVSI	A,(<CAIA>)
	CAIN	C,CR
CHK0:	MOVSI	A,(<JFCL>)	;IF FILENAME ENDS WITH CR, DON'T WORK TOO HARD
	MOVEM	A,INS#

	MOVE	A,[W,,FILEF]
	BLT	A,FILEF+3	;SAVE FILENAME WE ARE ABOUT TO LOOKUP
	INIT	217
	SIXBIT	/DSK/
	0
	UFATAL	404		;;;CANT INIT DSK
	LOOKUP	W
	JRST	NOLOOK
	JUMPN	Z,.+2
	UFATAL	406		;;;EMPTY FILE
	HLLM	Z,CMD

	MOVS	Z,Z
	MOVN	Z,Z
	MOVEM	Z,MAXPTR
	ADDI	Z,DATA
	CAMG	Z,JOBREL↑
	JRST	CHK2
	CORE	Z,
	UFATAL	410		;;;CORE UUO FAILED
CHK2:	IN	CMD
	JRST	.+2
	UFATAL	412		;;;IN UUO FAILED TO READ FILE
	RELEAS

	MOVEI	A,CHK50
	MOVEM	A,JOBREN↑
	SETZB	L,B
CHK3:	HRRZ	A,DATA(B)	;FORWARD STORY PTR
	HLRZ	C,DATA(A)	;BACKWARD STORY PTR
	CAME	C,B
	UFATAL	414		;;;INCORRECT BACK PTR IN STORY LIST
	SKIPN	B,A
	JRST	CHK3A		;END OF LIST
	LDB	C,[POINT 6,DATA+1(B),5];LEADING 6 BITS OF DUMP MODE COMMAND
	CAIE	C,77
	UFATAL	416		;;;STORY LIST ELEMENT DOES NOT POINT TO STORY LIST ELEMENT
	AOJA	L,CHK3
CHK3A:	OUTSTR	[ASCIZ/
/]
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ / stories.

/]

	MOVSI	A,400000
	MOVEM	A,LASTWD
	MOVEI	B,1
	TDZA	L,L
CHK4:	PUSHJ	P,OUTWRD
	HRRZ	A,DATA(B)	;FORWARD DICT PTR
	HLRZ	C,DATA(A)	;BACKWARD DICT PTR
	CAME	C,B
	UFATAL	420		;;;INCORRECT BACK PTR IN DICT LIST
	MOVE	B,A
	CAIN	B,1
	JRST	CHK4A
	MOVE	C,DATA+1(A)
	CAMGE	C,LASTWD#
	UFATAL	422		;;;INCORRECT ORDER IN DICT LIST
	MOVEM	C,LASTWD
	AOJA	L,CHK4

CHK4A:	INSKIP
	JFCL
	OUTSTR	[ASCIZ /
/]
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ / words./]
	EXIT

CHK50:	MOVEI	B,1
	MOVE	A,[377777,,-1]
	MOVEM	A,LASTWD
	TDZA	L,L
CHK5:	PUSHJ	P,OUTWRD
	HLRZ	A,DATA(B)	;BACKWARD DICT PTR
	HRRZ	C,DATA(A)	;FORWARD DICT PTR
	CAME	C,B
	UFATAL	424		;;;INCORRECT FORWARD PTR IN DICT LIST
	MOVE	B,A
	CAIN	B,1
	JRST	CHK5A

	MOVE	C,DATA+1(A)
	CAMLE	C,LASTWD#
	UFATAL	426		;;;INCORRECT ORDER IN DICT LIST
	MOVEM	C,LASTWD
	AOJA	L,CHK5

CHK5A:	INSKIP
	JFCL
	OUTSTR	[ASCIZ /
/]
	PUSHJ	P,DECOUT
	OUTSTR	[ASCIZ / words./]
	EXIT

OUTWRD:	XCT	INS#
	JRST	OUTWRQ
	MOVEI	X,1(A)
	MOVE	R,[POINT 7,TYBUF]
OUTWR1:	MOVE	Q,DATA(X)

	LDB	W,[POINT 5,Q,4]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	LDB	W,[POINT 5,Q,9]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	LDB	W,[POINT 5,Q,14]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	LDB	W,[POINT 5,Q,19]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	LDB	W,[POINT 5,Q,24]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	LDB	W,[POINT 5,Q,29]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	LDB	W,[POINT 5,Q,34]
	JUMPE	W,OUTWRX
	ORI	W,100
	IDPB	W,R

	TRNN	Q,1
	AOJA	X,OUTWR1
	SETZ	W,
OUTWRX:	IDPB	W,R
	OUTSTR	TYBUF
	MOVEI	W,1
	HLRE	Y,DATA+1(X)
	JUMPL	Y,[OUTSTR [ASCIZ / (non-word)/]
		JRST OUTWR4]
	JUMPE	Y,[SOJA W,OUTWR3]
	MOVEI	Z,1(X)
OUTWR2:	HRRZ	Z,DATA(Z)
	CAML	Z,MAXPTR
	UFATAL	430		;;;PTR OUT OF RANGE IN WORD LIST
	JUMPE	Z,OUTWR3
	AOJA	W,OUTWR2
OUTWR3:	EXCH	W,L
	OUTCHR	[" "]
	PUSHJ	P,DECOUT
	MOVE	L,W
OUTWR4:	OUTSTR	[ASCIZ/
/]
CPOPJ:	POPJ	P,

OUTWRQ:	MOVEI	W,1
	TDNN	W,DATA+1(A)
	AOJA	A,.-1
	MOVS	Y,DATA+2(A)	;PICK UP W.O.
	JUMPE	Y,CPOPJ		;BUILT IN WORD THAT HASN'T OCCURRED?
	CAIN	Y,-1		;NO, NON-WORD?
	POPJ	P,		;YES
OUTWR5:	LDB	Z,[POINT 6,DATA+1(Y),5];PICK UP HIGH ORDER 6 BITS OF DUMP MODE CMD
	CAIE	Z,77
	UFATAL	432		;;;WORD OCCURRENCE DOES NOT POINT TO STORY ENTRY
	HLRZ	Y,Y		;PTR TO NEXT W.O.
	JUMPE	Y,CPOPJ		;END OF W.O. LIST?
	CAML	Y,MAXPTR	;NO
	UFATAL	434		;;;PTR OUT OF RANGE IN WORD LIST
	MOVS	Y,DATA(Y)	;NEXT W.O.
	JRST	OUTWR5
;GETFIL	DECOUT	NXTDG	NOLOOK	NOENTR

COMMENT ⊗

Call with AC C containing first char of filename, and TYPNT containing
a byte pointer into rest of name.
Call by:
	PUSHJ P,GETFIL
	<FILENAME-SPECIFICATION-ERROR RETURN>
	<SUCCESS RETURN>

On success return, filename will be in four-word block at FILEF.

ACCUMULATOR USAGE:

	C holds current character.
	E counts characters in each part of name, ext, p, pn.
	R is byte pointer into filename block; also temp AC.
	F is flag register with following LEFT-half flags:
		QUOTE	;filename quoted with ↓
		GOTEXT	;have seen extension
		GOTP	;have seen project
		GOTPN	;have seen programmer name

STORAGE:

TYPNT is byte pointer to input string containing filename.
FILEF is a four-word LOOKUP-type block for holding scanned filename.

end of comment ⊗

GETFIL:	SETZM	FILEF
	MOVE	E,[FILEF,,FILEF+1]
	BLT	E,FILEF+3		;clear 4-word filename block
	TLZ	F,QUOTE!GOTEXT!GOTP!GOTPN
	MOVE	R,[POINT 6,FILEF]
	MOVEI	E,6			;limit filename to 6 chars
	CAIN	C,"↓"
	JRST	GETFL0
	CAIL	C,"0"
	CAILE	C,"z"
	TLO	F,QUOTE		;NOT A LETTER, QUOTE IT
	JRST	GETFL0

GETFL1:	TRZ	C,40		;convert char to sixbit
	TRZE	C,100
	TRO	C,40
	SOJL	E,.+2
	IDPB	C,R
GETFL2:	ILDB	C,TYPNT
GETFL0:	CAIN	C,"↓"
	TLCA	F,QUOTE
	CAIN	C,TAB
	JRST	GETFL2

;insert special tests here to have filename end on certain chars, eg:
;	cain	c,"/"
;	jrst	getfl5		;end of filename

	CAIG	C,"z"
	CAIGE	C," "		;legal SIXBIT char?
	JRST	GETFL5		;NO.  ASSUME END OF FILENAME

	TLNE	F,QUOTE		;ARE WE QUOTING A NAME?
	JRST	GETFL1		;YES, DON'T MAKE SPECIAL TESTS
	CAIN	C," "
	JRST	GETFL2		;IGNORE SPACES IN FILENAME
	CAIN	C,"]"
	JRST	GETFL4		;END OF PPN
	CAIN	C,"["
	JRST	GETFP		;PROJECT NEXT
	CAIN	C,","
	JRST	GETFPN		;PROGRAMMER NAME NEXT
	CAIE	C,"."
	JRST	GETFL1		;CHAR IN NAME
	TLOE	F,GOTEXT	;EXTENSION NEXT
	JRST	BADNAM		;OOPS, TWO EXTENSIONS
	MOVE	R,[POINT 6,FILEF+1]
GETFL3:	MOVEI	E,3
	JRST	GETFL2
GETFP:	TLOE	F,GOTP
	JRST	BADNAM		;OOPS, TWO PROJECTS
	MOVE	R,[POINT 6,FILEF+3]
	JRST	GETFL3
GETFPN:	TLON	F,GOTPN
	TLNN	F,GOTP
	JRST	BADNAM		;OOPS, TWO PROGRAMMER NAMES OR MISSING PROJECT
	MOVE	R,[POINT 6,FILEF+3,17]
	JUMPLE	E,GETFL3
	EXCH	C,FILEF+3
	LSH	C,-6		;RIGHT-JUSTIFY PROJECT
	SOJG	E,.-1
	EXCH	C,FILEF+3
	JRST	GETFL3

GETFL4:	ILDB	C,TYPNT		;GET CHAR AFTER "]"
GETFL5:	TLNN	F,GOTP		;PROJECT SPECIFIED?
	JRST	GETFL9		;NO
	TLNN	F,GOTPN		;PROGRAMMER NAME SPECIFIED?
	JRST	GETFL6		;NO, MAKE SURE PROJECT IS RIGHT JUSTIFIED
	JUMPLE	E,GETFL8	;YES.   PROGRAMMER NAME ALREADY RIGHT JUSTIFIED?
	HRRZ	R,FILEF+3	;NO
	LSH	R,-6		;RIGHT JUSTIFY PROGRAMMER NAME
	SOJG	E,.-1
	HRRM	R,FILEF+3
	JRST	GETFL8
GETFL6:	JUMPLE	E,GETFL7	;PROJECT ALREADY RIGHT JUSTIFIED?
	HLLZ	R,FILEF+3	;NO
	LSH	R,-6		;RIGHT-JUSTIFY PROJECT
	SOJG	E,.-1
	HLLZM	R,FILEF+3
GETFL7:	SETZ	R,		;GET OWN DISK PPN
	DSKPPN	R,
GETFL8:	HRRM	R,FILEF+3	;USE PROGRAMMER NAME FROM ALIAS

GETFL9:	AOS	(P)		;FILENAME SUCCESSFULLY SCANNED
BADNAM:	POPJ	P,

NOLOOK:	OUTSTR	[ASCIZ/
LOOKUP FAILED -- /]
	HRRZ	Y,X		;GET ERROR CODE
	CAILE	Y,MAXERR
	MOVEI	Y,MAXERR
	OUTSTR	@FERROR(Y)
	OUTSTR	[ASCIZ/.
/]
	UFATAL	440(X)		;;;LOOKUP FAILED

NOENTR:	OUTSTR	[ASCIZ/
ENTER FAILED -- /]
	HRRZ	X,X		;GET ERROR CODE
	CAILE	X,MAXERR
	MOVEI	X,MAXERR
	OUTSTR	@FERROR(X)
	OUTSTR	[ASCIZ/.
/]
	HALT	.

FERROR:	[ASCIZ/NO SUCH FILE/]
	[ASCIZ/ILLEGAL PPN/]
	[ASCIZ/PROTECTION VIOLATION/]
	[ASCIZ/FILE BUSY/]
MAXERR←←.-FERROR
	[ASCIZ/BAD RETRIEVAL OR OTHER HORRIBLE ERROR/]

DECOUT:	MOVE	Q,[POINT 7,TYBUF]
	PUSHJ	P,NXTDG
	SETZ	L,
	IDPB	L,Q
	OUTSTR	TYBUF
	POPJ	P,

NXTDG:	IDIVI	L,=10
	HRLM	M,(P)
	JUMPE	L,.+2
	PUSHJ	P,NXTDG
	HLRZ	M,(P)
	ADDI	M,60
	IDPB	M,Q
	POPJ	P,
;GETDAY	DATA

GETDAY:	MOVSI	X,'DAT'
	SETZB	Y,Z
	SETZ	W,
	DAYCNT	W,		;TODAY'S DATE
	SKIPN	AUTOCK		;SKIP IF WANT LAST COMPLETE DAY'S NEWS
	JRST	CHK0
	TIMER	A,		;TIME IN TICS
	IDIVI	A,=60		;TIME IN SECS
	CAIGE	A,APMIDNIGHT	;NEXT DAY AP STYLE YET?
	SUBI	W,1		;NO, USE YESTERDAY'S DATE
	JRST	CHK0
	

	LIT
	VAR
DATA:	0
	END	CHK